﻿Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports AcadEx = Autodesk.AutoCAD.Runtime.Exception

Public Class BlockOperation

    Private db As Database

    Public Sub New()
        db = HostApplicationServices.WorkingDatabase
    End Sub

    '创建块
    <CommandMethod("AddBlk")> _
    Public Sub AddBlock()
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Try
                '获得当前图形数据库的块表 
                Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForWrite), _
                                                  BlockTable)

                Dim psOpt As PromptStringOptions = New PromptStringOptions(Chr(10) + "输入图块的名称:")
                Dim psResult As PromptResult = Util.AcadEditor.GetString(psOpt)
                If psResult.Status <> PromptStatus.OK Then
                    Return
                End If
                '创建新的块表记录
                Dim btr As BlockTableRecord = New BlockTableRecord()
                btr.Name = psResult.StringResult
                '将块表记录添加到块表中 
                Dim blkDefId As ObjectId = bt.Add(btr)
                trans.AddNewlyCreatedDBObject(btr, True)


                Dim ptStart, ptEnd As Point3d
                ptStart = New Point3d(-10, 0, 0)
                ptEnd = New Point3d(10, 0, 0)
                '创建一条直线
                Dim line1 As Line = New Line(ptStart, ptEnd)
                ptStart = New Point3d(0, -10, 0)
                ptEnd = New Point3d(0, 10, 0)
                '创建一条直线
                Dim line2 As Line = New Line(ptStart, ptEnd)
                '创建一个圆
                Dim _circle As Circle = New Circle(Point3d.Origin, Vector3d.ZAxis, 6)
                '向块表记录中添加实体 
                btr.AppendEntity(line1)
                trans.AddNewlyCreatedDBObject(line1, True)
                btr.AppendEntity(line2)
                trans.AddNewlyCreatedDBObject(line2, True)
                btr.AppendEntity(_circle)
                trans.AddNewlyCreatedDBObject(_circle, True)
            Catch ex As AcadEx
                Util.Output(ex.StackTrace)
            Finally
                trans.Commit()
            End Try
        End Using
    End Sub

    '创建块
    <CommandMethod("InsertBlk")> _
    Public Sub InsertBlock()
        Dim psOpt As PromptStringOptions = New PromptStringOptions(Chr(10) + "输入图块的名称:")
        Dim psResult As PromptResult = Util.AcadEditor.GetString(psOpt)
        If psResult.Status <> PromptStatus.OK Then
            Return
        End If

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Try
                '获得当前图形数据库的块表 
                Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForWrite), _
                                                  BlockTable)

               
                '查找用户指定的块定义是否存在
                If Not bt.Has(psResult.StringResult) Then
                    Util.Output("当前图形中未包含指定名称的块定义！")
                    Return
                End If
                '获得用户输入的块参照的插入点
                Dim ppOpt As PromptPointOptions = New PromptPointOptions(Chr(10) + "输入块参照的插入点:")
                Dim ppResult As PromptPointResult = Util.AcadEditor.GetPoint(ppOpt)

                If ppResult.Status <> PromptStatus.OK Then
                    Return
                End If
                '获得用户指定的块表记录  
                Dim blkDefId As ObjectId = bt(psResult.StringResult)
                '创建块参照对象
                Dim br As BlockReference = New BlockReference(ppResult.Value, blkDefId)
                '将块参照添加到模型空间 
                Dim model_space As BlockTableRecord = DirectCast(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), _
                                                                BlockTableRecord)
                model_space.AppendEntity(br)
                trans.AddNewlyCreatedDBObject(br, True)
              
            Catch ex As AcadEx
                Util.Output(ex.StackTrace)
            Finally
                trans.Commit()
            End Try
        End Using
    End Sub

    '创建带有属性的块
    <CommandMethod("AddBlkWithAttr")> _
    Public Sub AddBlockWithAttr()
        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Try
                '获得当前图形数据库的块表 
                Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForWrite), _
                                                  BlockTable)

                Dim psOpt As PromptStringOptions = New PromptStringOptions(Chr(10) + "输入图块的名称:")
                Dim psResult As PromptResult = Util.AcadEditor.GetString(psOpt)
                If psResult.Status <> PromptStatus.OK Then
                    Return
                End If
                '创建新的块表记录
                Dim btr As BlockTableRecord = New BlockTableRecord()
                btr.Name = psResult.StringResult
                '将块表记录添加到块表中 
                Dim blkDefId As ObjectId = bt.Add(btr)
                trans.AddNewlyCreatedDBObject(btr, True)


                Dim ptStart, ptEnd As Point3d
                ptStart = New Point3d(-10, 0, 0)
                ptEnd = New Point3d(10, 0, 0)
                '创建一条直线
                Dim line1 As Line = New Line(ptStart, ptEnd)
                ptStart = New Point3d(0, -10, 0)
                ptEnd = New Point3d(0, 10, 0)
                '创建一条直线
                Dim line2 As Line = New Line(ptStart, ptEnd)
                '创建一个圆
                Dim _circle As Circle = New Circle(Point3d.Origin, Vector3d.ZAxis, 6)
                ' 创建一个属性  输入直径
                Dim attDef As AttributeDefinition = New AttributeDefinition(ptEnd, "20", "直径", "输入直径", ObjectId.Null)
                '向块表记录中添加实体 
                btr.AppendEntity(line1)
                trans.AddNewlyCreatedDBObject(line1, True)
                btr.AppendEntity(line2)
                trans.AddNewlyCreatedDBObject(line2, True)
                btr.AppendEntity(_circle)
                trans.AddNewlyCreatedDBObject(_circle, True)
                btr.AppendEntity(attDef)
                trans.AddNewlyCreatedDBObject(attDef, True)
            Catch ex As AcadEx
                Util.Output(ex.StackTrace)
            Finally
                trans.Commit()
            End Try
        End Using
    End Sub

    '创建块
    <CommandMethod("InsertBlkWithAttr")> _
    Public Sub InsertBlockWithAttr()
        Dim psOpt As PromptStringOptions = New PromptStringOptions(Chr(10) + "输入图块的名称:")
        Dim psResult As PromptResult = Util.AcadEditor.GetString(psOpt)
        If psResult.Status <> PromptStatus.OK Then
            Return
        End If

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Try
                '获得当前图形数据库的块表 
                Dim bt As BlockTable = DirectCast(trans.GetObject(db.BlockTableId, OpenMode.ForWrite), _
                                                  BlockTable)


                '查找用户指定的块定义是否存在
                If Not bt.Has(psResult.StringResult) Then
                    Util.Output("当前图形中未包含指定名称的块定义！")
                    Return
                End If
                '获得用户输入的块参照的插入点
                Dim ppOpt As PromptPointOptions = New PromptPointOptions(Chr(10) + "输入块参照的插入点:")
                Dim ppResult As PromptPointResult = Util.AcadEditor.GetPoint(ppOpt)

                If ppResult.Status <> PromptStatus.OK Then
                    Return
                End If
                '获得用户指定的块表记录  
                Dim blkDefId As ObjectId = bt(psResult.StringResult)
                '创建块参照对象
                Dim br As BlockReference = New BlockReference(ppResult.Value, blkDefId)

                '将块参照添加到模型空间 
                Dim model_space As BlockTableRecord = DirectCast(trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), _
                                                                BlockTableRecord)
                model_space.AppendEntity(br)
                trans.AddNewlyCreatedDBObject(br, True)
                '判断指定的块表记录是否包含属性定义 
                Dim btr As BlockTableRecord = DirectCast(trans.GetObject(blkDefId, OpenMode.ForWrite), _
                                                         BlockTableRecord)

                If btr.HasAttributeDefinitions() Then
                    For Each entId As ObjectId In btr
                        Dim ent As Entity = DirectCast(trans.GetObject(entId, OpenMode.ForRead), _
                                                       Entity)
                        If TypeOf ent Is AttributeDefinition Then
                            Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
                            '创建一个新的属性对象
                            Dim attr As AttributeReference = New AttributeReference()
                            With attr
                                '从属性定义获得属性对象的对象特性
                                .SetPropertiesFrom(attDef)
                                '设置属性对象的其他特性
                                .Visible = attDef.Visible
                                Dim ptBase As Point3d = attDef.Position
                                ptBase += br.Position.GetAsVector()
                                .Position = ptBase
                                .Height = attDef.Height
                                .Rotation = attDef.Rotation
                                '获得属性对象的Tag、Prompt和TextString
                                .Tag = attDef.Tag
                                Dim str As String = attDef.Prompt
                                Util.Output(str)
                                .FieldLength = 30
                                .TextString = "40"
                            End With
                            '向块参照追加属性对象 
                            br.AttributeCollection.AppendAttribute(attr)
                            trans.AddNewlyCreatedDBObject(attr, True)
                        End If
                    Next
                End If
            Catch ex As AcadEx
                Util.Output(ex.StackTrace)
            Finally
                trans.Commit()
            End Try
        End Using
    End Sub

End Class
